:- module(avm_objects, [
						get_heap/1,
						get_base_object/1,
						clone_object/2,
						extend_object/2,
						subclass_object/3,
						subclass_object/4,
						create_array_object/2,
						create_array_object_from_list/2,
					    get_property/3,
					    set_property/3,
						set_properties/2,
					    set_internal_property/3,
					    has_property/2,
						invoke_call/3,
						invoke_construct/3,
						object_functor/2,
						expanded_object_functor/2
					   ]).

:- use_module(library(assoc)).
:- use_module(library(lists)).

:- initialization(init_heap).

init_heap :-
	write('Initializing heap...'), nl,
	empty_assoc(EmptyHeap),
	nb_setval(obj_heap,EmptyHeap),
	nb_setval(obj_counter,3),
	create_empty_object,
	create_base_object,
	create_base_array_object,
	write('Initialized heap.'), nl.

obj_counter(Ref) :-
	b_getval(obj_counter,Ref),
	NRef is Ref+1,
	b_setval(obj_counter,NRef).

create_empty_object :-
	empty_assoc(Object),
	nb_getval(obj_heap,OldHeap),
	put_assoc(0,OldHeap,Object,NewHeap),
	nb_setval(obj_heap,NewHeap).

create_base_object :-
	list_to_assoc(['[[Prototype]]'-prop('[[Prototype]]',null,f,f,f,t),
				   '[[Class]]'-prop('[[Class]]','Object',f,f,f,t),
				   '[[Get]]'-prop('[[Get]]',native_get,f,f,f,t),
				   '[[Put]]'-prop('[[Put]]',native_put,f,f,f,t),
				   '[[CanPut]]'-prop('[[CanPut]]',native_canput,f,f,f,t),
				   '[[HasProperty]]'-prop('[[HasProperty]]',native_hasprop,f,f,f,t),
				   '[[Delete]]'-prop('[[Delete]]',native_delete,f,f,f,t),
				   '[[DefaultValue]]'-prop('[[DefaultValue]]',native_default,f,f,f,t)],Object),
	nb_getval(obj_heap,OldHeap),
	put_assoc(1,OldHeap,Object,NewHeap),
	nb_setval(obj_heap,NewHeap).

create_base_array_object :-
	list_to_assoc(['[[Prototype]]'-prop('[[Prototype]]',ref(1),f,f,f,t),
				   '[[Class]]'-prop('[[Class]]','Array',f,f,f,t),
				   '[[Get]]'-prop('[[Get]]',native_get,f,f,f,t),
				   '[[Put]]'-prop('[[Put]]',native_put,f,f,f,t)],Object),
	nb_getval(obj_heap,OldHeap),
	put_assoc(2,OldHeap,Object,NewHeap),
	nb_setval(obj_heap,NewHeap).

/**
 * An object is an unordered collection of properties.
 * Objects are implemented here as a dictionary from
 * property names to properties.
 *
 * A property is a tuple of name, value, and flags (Read Only,
 * Don't Delete, Don't Enum, and Internal).
 *
 * Properties are represented by the functor:
 *   prop(Name,Value,ReadOnly,DontDelete,DontEnum,Internal)
 * where each flag is either 'f' (false) or 't' (true)
 */

%====================================================================
% External Object Manipulation Predicates
%====================================================================

get_heap(Heap) :-
	b_getval(obj_heap,Heap).

get_base_object(ref(1)).

create_array_object(Length,Object) :-
	list_of_undefineds(Length,List),
	create_array_object_from_list(List,Object).

create_array_object_from_list(Elems,Object) :-
	extend_object(ref(2),Object),
	length(Elems,Length),
	set_property(Object,length,Length),
	set_array_properties(Object,0,Elems).

clone_object(ref(Orig),ref(Clone)) :-
	get_object(Orig,Object),
	obj_counter(Clone),
	set_object(Clone,Object).

extend_object(Base,New) :-
	clone_object(ref(0),New),
	set_internal_property(New,'[[Prototype]]',Base).

subclass_object(Base,ClassName,New) :-
	extend_object(Base,New),
	set_internal_property(New,'[[Class]]',ClassName).

subclass_object(Base,ClassName,Properties,New) :-
	subclass_object(Base,ClassName,New),
	set_properties(New,Properties).

get_property(ref(Ref),Name,Value) :-
	get_property_internal(ref(Ref),'[[Get]]',prop(_N,Predicate,_F1,_F2,_F3,t)),
	call(Predicate,ref(Ref),Name,Value).

set_property(ref(Ref),Name,Value) :-
	get_property_internal(ref(Ref),'[[Put]]',prop(_N,Predicate,_F1,_F2,_F3,t)),
	call(Predicate,ref(Ref),Name,Value).

set_properties(ref(_Ref),[]).
set_properties(ref(Ref),[Name-Value|Rest]) :-
	set_property(ref(Ref),Name,Value),
	set_properties(ref(Ref),Rest).

set_properties(ref(Ref), [Name | Rest]) :-
	Name \= _ - _,
	set_property(ref(Ref), Name, undefined),
	set_properties(ref(Ref), Rest).

set_internal_property(ref(Ref),Name,Value) :-
	get_property_internal(ref(Ref),Name,prop(Name,_OldValue,F1,F2,F3,F4)),
	set_property_internal(ref(Ref),Name,prop(Name,Value,F1,F2,F3,F4)).
set_internal_property(ref(Ref),Name,Value) :-
	get_property_internal(ref(Ref),Name,undefined),
	set_property_internal(ref(Ref),Name,prop(Name,Value,f,f,f,t)).
set_internal_property(ref(Ref),Name,Value) :-
	\+get_property_internal(ref(Ref),Name,_Prop),
	set_property_internal(ref(Ref),Name,prop(Name,Value,f,f,f,t)).

has_property(ref(Ref),Name) :-
	get_property_internal(ref(Ref),'[[HasProperty]]',prop(_N,Predicate,_F1,_F2,_F3,t)),
	call(Predicate,ref(Ref),Name).

invoke_call(Args,_State0,_State1) :-
	get_property_internal(ref(Ref),'[[Call]]',prop(_N,Predicate,_F1,_F2,_F3,t)),
	call(Predicate,ref(Ref),Args).

invoke_construct(Args,_State0,_State1) :-
	get_property_internal(ref(Ref),'[[Construct]]',prop(_N,Predicate,_F1,_F2,_F3,t)),
	call(Predicate,ref(Ref),Args).

%====================================================================
% Internal Object Manipulation Predicates
%====================================================================

get_object(Ref,Object) :-
	b_getval(obj_heap,Heap),
	get_assoc(Ref,Heap,Object).

set_object(Ref,Object) :-
	b_getval(obj_heap,OldHeap),
	put_assoc(Ref,OldHeap,Object,NewHeap),
	b_setval(obj_heap,NewHeap).

get_property_internal(ref(Ref),Name,Property) :-
	get_object(Ref,Object),
	get_assoc(Name,Object,Property).
get_property_internal(ref(Ref),Name,Property) :-
	get_object(Ref,Object),
	\+get_assoc(Name,Object,_Property),
	get_assoc('[[Prototype]]',Object,prop(_N,Value,_F1,_F2,_F3,_F4)),
	Value \= null,
	get_property_internal(Value,Name,Property).
get_property_internal(ref(Ref),Name,undefined) :-
	get_object(Ref,Object),
	\+get_assoc(Name,Object,_Property),
	get_assoc('[[Prototype]]',Object,prop(_N,null,_F1,_F2,_F3,_F4)).

set_property_internal(ref(Ref),Name,Value) :-
	get_object(Ref,Object),
	put_assoc(Name,Object,Value,NewObject),
	set_object(Ref,NewObject).

%--------------------------------------------------------------------
% Array Object internal predicates
%--------------------------------------------------------------------

list_of_undefineds(0,[]).
list_of_undefineds(N,[undefined|Rest]) :-
	Next is N-1,
	list_of_undefineds(Next,Rest).

set_array_properties(_Object,_N,[]).
set_array_properties(Object,N,[H|T]) :-
	set_property(Object,N,H),
	Next is N+1,
	set_array_properties(Object,Next,T).

%====================================================================
% Internal Method Implementations for native objects
%====================================================================

native_get(ref(Ref),Name,Value) :-
	get_property_internal(ref(Ref),Name,prop(Name,Value,_F1,_F2,_F3,f)).

native_put(ref(Ref),Name,Value) :-
	get_property_internal(ref(Ref),'[[CanPut]]',prop(_N,Predicate,_F1,_F2,_F3,t)),
	call(Predicate,ref(Ref),Name),
	get_property_internal(ref(Ref),Name,prop(Name,_OldValue,F1,F2,F3,F4)),
	set_property_internal(ref(Ref),Name,prop(Name,Value,F1,F2,F3,F4)).
native_put(ref(Ref),Name,Value) :-
	get_property_internal(ref(Ref),'[[CanPut]]',prop(_N,Predicate,_F1,_F2,_F3,t)),
	call(Predicate,ref(Ref),Name),
	get_property_internal(ref(Ref),Name,undefined),
	set_property_internal(ref(Ref),Name,prop(Name,Value,f,f,f,f)).
native_put(ref(Ref),Name,_Value) :-
	get_property_internal(ref(Ref),'[[CanPut]]',prop(_N,Predicate,_F1,_F2,_F3,t)),
	\+call(Predicate,ref(Ref),Name).

native_canput(ref(Ref),Name) :-
	get_property_internal(ref(Ref),Name,undefined).
native_canput(ref(Ref),Name) :-
	get_property_internal(ref(Ref),Name,prop(Name,_Val,f,_F2,_F3,f)).

native_hasprop(ref(Ref),Name) :-
	get_property_internal(ref(Ref),Name,prop(Name,_Val,_F1,_F2,_F3,f)).

native_delete(ref(_Ref),_Name) :- true.

native_default(ref(_Ref),_Name,tt) :- true.

array_put(ref(_Ref),_Name,_Value) :- true.


% ==============================================================================
% #region Object -> Functor code

object_functor(ref(Ref), Functor) :-
	get_object(Ref, Object),
	assoc_to_list(Object, ObjList),
	Functor =.. [object, ref(Ref) | ObjList].



% FIXME: Beware infinite loops with the instruction `next` and `jumplabel`
% instructions!
% FIXME: This only outputs the same as object_functor. wtf.
expanded_object_functor(ref(Ref), Functor) :-
	get_object(Ref, Object),
	assoc_to_list(Object, ObjList),
	process_property_list(ObjList, ProcessedList),
	Functor =.. [object, ref(Ref) | ProcessedList].


process_property_list([Prop - ref(X) | Props], [Prop - OFunctor | ExpandProps]) :-
	expanded_object_functor(ref(X), OFunctor),
	process_property_list(Props, ExpandProps).

process_property_list([Prop - Value | Props], [Prop - Value | ExpandProps]) :-
	Props \= ref(_X),
	process_property_list(Props, ExpandProps).

process_property_list([], []).

